***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
F1  = 'DLV_PHAR'                                                                                                                                                                                                                                          
F11 = 'DLVDATCD'                                                                                                                                                                                                                                          
F12 = 'DLVDATCM'                                                                                                                                                                                                                                          
F2  = 'COMPANY'                                                                                                                                                                                                                                           
F3  = 'DLV_TEMP'                                                                                                                                                                                                                                          
DO ADDRESSS                                                                                                                                                                                                                                               
@ 8,1 clea to 23,78                                                                                                                                                                                                                                       
@ 7,4 to 9,37                                                                                                                                                                                                                                             
@ 8,6 say 'PRINT RECAP. OF DELIVERY ORDER'                                                                                                                                                                                                                
DSP1=SAVESCREEN(24,0,24,79)                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F1                                                                                                                                                                                                                                                
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F2                                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
*---------------                                                                                                                                                                                                                                          
STOR 0 TO MNSORT                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
DO BOX2 WITH 10,10,'Sorted by :','S.O. #','Client #','N','BG','W+','N',MNSORT,.T.,.T.                                                                                                                                                                     
if lastkey()=27                                                                                                                                                                                                                                           
   set colo to bg+/b,w+/n                                                                                                                                                                                                                                 
   return                                                                                                                                                                                                                                                 
endif                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
IF MNSORT = 1                                                                                                                                                                                                                                             
   SET INDE TO &DR&F11                                                                                                                                                                                                                                    
ELSE                                                                                                                                                                                                                                                      
   SET INDE TO &DR&F12                                                                                                                                                                                                                                    
ENDI                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
SET COLO TO W/N                                                                                                                                                                                                                                           
@15,12 CLEA TO 17,44                                                                                                                                                                                                                                      
SET COLO TO N/BG,W+/N                                                                                                                                                                                                                                     
@14,10 CLEA TO 16,42                                                                                                                                                                                                                                      
@14,10 TO 16,42 DOUBLE                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
@15,12 SAY 'DATE :   /  /      TO    /  /  '                                                                                                                                                                                                              
                                                                                                                                                                                                                                                          
STOR CTOD('  /  /    ') TO dDate1, dDate2, dDate                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
DO WHIL .T.                                                                                                                                                                                                                                               
   @15,19 GET dDate1                                                                                                                                                                                                                                      
   READ                                                                                                                                                                                                                                                   
   IF dDate1 = CTOD('  /  /    ') .OR. LASTKEY() = 27                                                                                                                                                                                                     
      EXIT                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
   @15,33 GET dDate2                                                                                                                                                                                                                                      
   READ                                                                                                                                                                                                                                                   
   IF dDate2 < dDate1                                                                                                                                                                                                                                     
      LOOP                                                                                                                                                                                                                                                
   ELSE                                                                                                                                                                                                                                                   
      EXIT                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
ENDD                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
IF dDate1 = CTOD('  /  /    ') .OR. LASTKEY() = 27                                                                                                                                                                                                        
   CLOS ALL                                                                                                                                                                                                                                               
   RETU                                                                                                                                                                                                                                                   
ENDI                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
IF MNSORT = 1                                                                                                                                                                                                                                             
   SET COLO TO W/N                                                                                                                                                                                                                                        
   @19,12 CLEA TO 21,68                                                                                                                                                                                                                                   
   SET COLO TO N/BG,W+/N                                                                                                                                                                                                                                  
   @18,10 CLEA TO 20,66                                                                                                                                                                                                                                   
   @18,10 TO 20,66 DOUBLE                                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
   @19,12 SAY 'DO. # :                      TO                      '                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
   STOR SPAC(20) TO cPo1, cPo2, cPo                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
   DO WHIL .T.                                                                                                                                                                                                                                            
      @19,20 GET cPo1                                                                                                                                                                                                                                     
      READ                                                                                                                                                                                                                                                
      IF cPo1 = SPAC(20) .OR. LASTKEY() = 27                                                                                                                                                                                                              
         EXIT                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
      @19,44 GET cPo2                                                                                                                                                                                                                                     
      READ                                                                                                                                                                                                                                                
      IF cPo2 < cPo1                                                                                                                                                                                                                                      
         LOOP                                                                                                                                                                                                                                             
      ELSE                                                                                                                                                                                                                                                
         EXIT                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
   ENDD                                                                                                                                                                                                                                                   
   IF cPo1 = SPAC(20) .OR. LASTKEY() = 27                                                                                                                                                                                                                 
      CLOS ALL                                                                                                                                                                                                                                            
      RETU                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
ELSE                                                                                                                                                                                                                                                      
   SET COLO TO W/N                                                                                                                                                                                                                                        
   @19,12 CLEA TO 21,40                                                                                                                                                                                                                                   
   SET COLO TO N/BG,W+/N                                                                                                                                                                                                                                  
   @18,10 CLEA TO 20,38                                                                                                                                                                                                                                   
   @18,10 TO 20,38 DOUBLE                                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
   @19,12 SAY 'CLIENT CODE :      TO      '                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
   STOR SPAC(4) TO cClien1, cClien2, cClien                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
   DO WHIL .T.                                                                                                                                                                                                                                            
      @19,26 GET cClien1                                                                                                                                                                                                                                  
      READ                                                                                                                                                                                                                                                
      IF cClien1 = SPAC(4) .OR. LASTKEY() = 27                                                                                                                                                                                                            
         EXIT                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
      @19,34 GET cClien2                                                                                                                                                                                                                                  
      READ                                                                                                                                                                                                                                                
      IF cClien2 < cClien1                                                                                                                                                                                                                                
         LOOP                                                                                                                                                                                                                                             
      ELSE                                                                                                                                                                                                                                                
         EXIT                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
   ENDD                                                                                                                                                                                                                                                   
   IF cClien1 = SPAC(4) .OR. LASTKEY() = 27                                                                                                                                                                                                               
      CLOS ALL                                                                                                                                                                                                                                            
      RETU                                                                                                                                                                                                                                                
   ENDI                                                                                                                                                                                                                                                   
ENDI                                                                                                                                                                                                                                                      
*---------------                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
RESTSCREEN(24,0,24,79,DSP1)                                                                                                                                                                                                                               
KLR='N'                                                                                                                                                                                                                                                   
DO SET_DEV                                                                                                                                                                                                                                                
IF KLR='Y'                                                                                                                                                                                                                                                
   SET EXCLU OFF                                                                                                                                                                                                                                          
   CLOSE DATA                                                                                                                                                                                                                                             
   CLOSE INDEX                                                                                                                                                                                                                                            
   RETURN                                                                                                                                                                                                                                                 
ENDIF                                                                                                                                                                                                                                                     
   SET COLO TO W+/B+                                                                                                                                                                                                                                      
   DO ADDRESSS                                                                                                                                                                                                                                            
*   @  7,  3  TO  9, 33    DOUBLE                                                                                                                                                                                                                         
*   @  8,  5  SAY "PRINT RECAP. DELIVERY ORDER"                                                                                                                                                                                                           
   KLR='N'                                                                                                                                                                                                                                                
   br=100                                                                                                                                                                                                                                                 
   fl=0                                                                                                                                                                                                                                                   
   hl=0                                                                                                                                                                                                                                                   
   ttl=0                                                                                                                                                                                                                                                  
   store 0 to ttl1,ttl2,ttl3,ttl4,ttl5                                                                                                                                                                                                                    
   set devi to print                                                                                                                                                                                                                                      
*   @ 0,0 say chr(18) pict 'x'                                                                                                                                                                                                                            
*   @ 0,0 SAY CHR(27)+CHR(77)                                                                                                                                                                                                                             
                                                                                                                                                                                                                                                          
SELE 1                                                                                                                                                                                                                                                    
GO TOP                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
IF MNSORT = 1                                                                                                                                                                                                                                             
   DO WHILE .NOT. EOF()                                                                                                                                                                                                                                   
      IF (DATE_DELV > dDate1) .AND. (DATE_DELV < dDate2) .AND.;                                                                                                                                                                                           
      (DELV_ORDER > cPo1) .AND. (DELV_ORDER < cPo2)                                                                                                                                                                                                       
         if br>57                                                                                                                                                                                                                                         
            if fl>0                                                                                                                                                                                                                                       
               eject                                                                                                                                                                                                                                      
            else                                                                                                                                                                                                                                          
               fl=1                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
            cl=50                                                                                                                                                                                                                                         
            hl=hl+1                                                                                                                                                                                                                                       
            @  2, 44 say 'RECAPITULATION OF DELIVERY ORDER'                                                                                                                                                                                               
            @  3, 44 SAY '--------------------------------'                                                                                                                                                                                               
            @  4,122 say 'PAGE : '                                                                                                                                                                                                                        
            @  4,129 say hl pict '999'                                                                                                                                                                                                                    
            @  5,117 say 'DATE : '                                                                                                                                                                                                                        
            @  5, 124 say DATE()                                                                                                                                                                                                                          
            @  6,  0 say repl('=',132)                                                                                                                                                                                                                    
            @  7,  0 say 'ORDER #'                                                                                                                                                                                                                        
            @  7, 17 say 'DATE'                                                                                                                                                                                                                           
            @  7, 26 say 'COMPANY'                                                                                                                                                                                                                        
            @  7, 34 say 'NAME'                                                                                                                                                                                                                           
            @  7, 71 say '  TOTAL VALUE'                                                                                                                                                                                                                  
            @  7, 87 SAY 'DRUG/DISPOSABLE NAME'                                                                                                                                                                                                           
            @  7,124 SAY 'QUANTITY'                                                                                                                                                                                                                       
            @  9,0 say repl('-',132)                                                                                                                                                                                                                      
            br=9                                                                                                                                                                                                                                          
         endif                                                                                                                                                                                                                                            
         br=br+1                                                                                                                                                                                                                                          
         dDate = DATE_DELV                                                                                                                                                                                                                                
         ORDNUM=delv_order                                                                                                                                                                                                                                
         DATDLV=PRINT_DATE                                                                                                                                                                                                                                
         CODCLI=COMP_CODE                                                                                                                                                                                                                                 
         NAMCLI=CLIENT                                                                                                                                                                                                                                    
         @ BR, 0 SAY ORDNUM                                                                                                                                                                                                                               
         @ BR,17 SAY DATDLV                                                                                                                                                                                                                               
         @ BR,26 SAY CODCLI                                                                                                                                                                                                                               
         @ BR,34 SAY NAMCLI                                                                                                                                                                                                                               
         TTL=0                                                                                                                                                                                                                                            
         SEEK DTOS(dDate)+ORDNUM                                                                                                                                                                                                                          
         DO WHILE (dDate=DATE_DELV) .AND. (delv_order=ORDNUM) .AND. .NOT. EOF()                                                                                                                                                                           
            TTL=TTL+VAL_DELV                                                                                                                                                                                                                              
            SKIP                                                                                                                                                                                                                                          
         ENDDO                                                                                                                                                                                                                                            
         @ BR,71 SAY TTL PICT '9,999,999,999'                                                                                                                                                                                                             
         SEEK DTOS(dDate)+ORDNUM                                                                                                                                                                                                                          
         DO WHILE (dDate=DATE_DELV) .AND. (delv_order=ORDNUM) .AND. .NOT. EOF()                                                                                                                                                                           
            NMPH=SUBS(ALLTRIM(PHAR_NAME)+' '+ALLTRIM(PHAR_TYPE)+' '+ALLTRIM(PHAR_QANT)+' '+ALLTRIM(PHAR_UNIT),1,35)                                                                                                                                       
            @ BR,87 SAY NMPH                                                                                                                                                                                                                              
            @ BR,127 SAY QANT_DELV PICT '9,999'                                                                                                                                                                                                           
            BR=BR+1                                                                                                                                                                                                                                       
            SKIP                                                                                                                                                                                                                                          
         ENDDO                                                                                                                                                                                                                                            
         TTL1=TTL1+TTL                                                                                                                                                                                                                                    
      ELSE                                                                                                                                                                                                                                                
         SKIP                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
ELSE                                                                                                                                                                                                                                                      
   DO WHILE .NOT. EOF()                                                                                                                                                                                                                                   
      IF (DATE_DELV > dDate1) .AND. (DATE_DELV < dDate2) .AND.;                                                                                                                                                                                           
      (COMP_CODE > cClien1) .AND. (COMP_CODE < cClien2)                                                                                                                                                                                                   
         if br>57                                                                                                                                                                                                                                         
            if fl>0                                                                                                                                                                                                                                       
               eject                                                                                                                                                                                                                                      
            else                                                                                                                                                                                                                                          
               fl=1                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
            cl=50                                                                                                                                                                                                                                         
            hl=hl+1                                                                                                                                                                                                                                       
            @  2, 44 say 'RECAPITULATION OF DELIVERY ORDER'                                                                                                                                                                                               
            @  3, 44 SAY '--------------------------------'                                                                                                                                                                                               
            @  4,122 say 'PAGE : '                                                                                                                                                                                                                        
            @  4,129 say hl pict '999'                                                                                                                                                                                                                    
            @  5,117 say 'DATE : '                                                                                                                                                                                                                        
            @  5, 124 say DATE()                                                                                                                                                                                                                          
            @  6,  0 say repl('=',132)                                                                                                                                                                                                                    
            @  7,  0 say 'ORDER #'                                                                                                                                                                                                                        
            @  7, 17 say 'DATE'                                                                                                                                                                                                                           
            @  7, 26 say 'COMPANY'                                                                                                                                                                                                                        
            @  7, 34 say 'NAME'                                                                                                                                                                                                                           
            @  7, 71 say '  TOTAL VALUE'                                                                                                                                                                                                                  
            @  7, 87 SAY 'DRUG/DISPOSABLE NAME'                                                                                                                                                                                                           
            @  7,124 SAY 'QUANTITY'                                                                                                                                                                                                                       
            @  9,0 say repl('-',132)                                                                                                                                                                                                                      
            br=9                                                                                                                                                                                                                                          
         endif                                                                                                                                                                                                                                            
         br=br+1                                                                                                                                                                                                                                          
         dDate = DATE_DELV                                                                                                                                                                                                                                
         cClien= COMP_CODE                                                                                                                                                                                                                                
         ORDNUM=delv_order                                                                                                                                                                                                                                
         DATDLV=PRINT_DATE                                                                                                                                                                                                                                
         CODCLI=COMP_CODE                                                                                                                                                                                                                                 
         NAMCLI=CLIENT                                                                                                                                                                                                                                    
         @ BR, 0 SAY ORDNUM                                                                                                                                                                                                                               
         @ BR,17 SAY DATDLV                                                                                                                                                                                                                               
         @ BR,26 SAY CODCLI                                                                                                                                                                                                                               
         @ BR,34 SAY NAMCLI                                                                                                                                                                                                                               
         TTL=0                                                                                                                                                                                                                                            
         SEEK DTOS(dDate)+cClien+ORDNUM                                                                                                                                                                                                                   
         DO WHILE (dDate=DATE_DELV) .AND. (cClien = COMP_CODE) .AND. (delv_order=ORDNUM) .AND. .NOT. EOF()                                                                                                                                                
            TTL=TTL+VAL_DELV                                                                                                                                                                                                                              
            SKIP                                                                                                                                                                                                                                          
         ENDDO                                                                                                                                                                                                                                            
         @ BR,71 SAY TTL PICT '9,999,999,999'                                                                                                                                                                                                             
         SEEK DTOS(dDate)+cClien+ORDNUM                                                                                                                                                                                                                   
         DO WHILE (dDate=DATE_DELV) .AND. (cClien = COMP_CODE) .AND. (delv_order=ORDNUM) .AND. .NOT. EOF()                                                                                                                                                
            NMPH=SUBS(ALLTRIM(PHAR_NAME)+' '+ALLTRIM(PHAR_TYPE)+' '+ALLTRIM(PHAR_QANT)+' '+ALLTRIM(PHAR_UNIT),1,35)                                                                                                                                       
            @ BR,87 SAY NMPH                                                                                                                                                                                                                              
            @ BR,127 SAY QANT_DELV PICT '9,999'                                                                                                                                                                                                           
            BR=BR+1                                                                                                                                                                                                                                       
            SKIP                                                                                                                                                                                                                                          
         ENDDO                                                                                                                                                                                                                                            
         TTL1=TTL1+TTL                                                                                                                                                                                                                                    
      ELSE                                                                                                                                                                                                                                                
         SKIP                                                                                                                                                                                                                                             
      ENDI                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
ENDI                                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
BR=BR+1                                                                                                                                                                                                                                                   
@ BR,0 SAY REPL('-',132)                                                                                                                                                                                                                                  
BR=BR+1                                                                                                                                                                                                                                                   
@ BR,70 SAY TTL1 PICT '99,999,999,999'                                                                                                                                                                                                                    
BR=BR+1                                                                                                                                                                                                                                                   
@ BR,0 SAY REPL('=',132)                                                                                                                                                                                                                                  
EJECT                                                                                                                                                                                                                                                     
@ 0,0 SAY CHR(18) PICT 'X'                                                                                                                                                                                                                                
SET DEVI TO SCREEN                                                                                                                                                                                                                                        
CLOSE DATA                                                                                                                                                                                                                                                
CLOSE INDEX                                                                                                                                                                                                                                               
RETURN                                                                                                                                                                                                                                                    
